Developer CD Series 1992 …SCII & the Runetime Code/ADC Developer CD (1992-07) (''Butch ASCII And The Runtime Code'')_iso/Dev.CD 199207.iso/Development Platforms/HyperCard Related/XCMDs & XFCNs/GetFileNames 1.1/GetFileNames.p

Text File | 1990-09-05 | 8.3 KB | 320 lines | [TEXT/MPS ]

{
    Written by Chris Thorman.
    Copyright 1990 Apple Computer, Inc.

    Permission granted for any kind of use as long as this notice is retained.

    Apple makes no claims as to the correctness or value of this software for
    and purpose.  In fact, this software may well have bugs which will crash
    your machine at crucial moments.
}

{$R-}
{$S GetFileNames  }

{
    GetFileNames [PathName], [Directories]

    This HyperCard external function returns a string containing a return-delimited
    list of the file names in the directory specified by PathName.

    If PathName is the name of a directory (ending either in the directory
    name or the directory name followed by a colon character),
    then that directory is searched.

    If PathName is the name of a file, then that file’s directory is searched (and
    it will be one of the files returned if you’re asking for files).

    If PathName is not specified or is passed as empty, then the file name of the
    current stack is used as a default (and files in the same directory as that
    stack are returned).

    Since elements of the return value are delimited by return characters, they
    can be accessed by using the “line” operators in HyperCard.   I.e., the number
    of lines in the return value is the number of files found.  Line 1 is file 1;
    line 2 is file 2, etc.

    If Directories is true, then only directory names will be returned; NOT file names.

    If the return value is empty, no files or directories were found.  [In HyperTalk, the number
    of lines in empty is conveniently zero]

    If an error occurs, then the return value will be only one line long, and
    will be of the form "•••••••• Error: <Descriptive Message>."
 }

UNIT DummyUnit;

INTERFACE

    USES
    {    Traps, Desk, OSUtils, }
        Files, ToolUtils, Memory,
        Types, Events, TextEdit, Menus, HyperXCmd;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

    PROCEDURE GetFileNames (paramPtr: XCmdPtr);
    FORWARD;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
    BEGIN
        GetFileNames (paramPtr)
    END { entrypoint } ;


    PROCEDURE GetFileNames (paramPtr: XCmdPtr);

    CONST

    MaxParams =        2;

    TYPE

    ParamArray =        PACKED ARRAY [1..MaxParams] OF Str255;

    VAR
    TheResult:            Handle;

    ParamStrings:        ParamArray;

    PathnameParam:        Str255;
    DirectoriesParam:    Boolean;

    ThisDirRefNum:        Integer;
    ThisVolRefNum:        Integer;

    TempString:            Str255;
    TempHandle:            Handle;

PROCEDURE CleanUpBeforeFailure;
        BEGIN
            DisposHandle(TheResult);
        END;

        PROCEDURE ExitWithHandle(aHandle: Handle);
        BEGIN
            ZeroTermHandle(paramPtr, aHandle);
            WITH paramPtr^ DO BEGIN
                returnValue := aHandle;
                EXIT(GetFileNames);
            END;
        END;

        PROCEDURE ExitWithMessage(aString: Str255);
        BEGIN
            WITH paramPtr^ DO BEGIN
                returnValue := PasToZero(paramPtr, aString);
                EXIT(GetFileNames);
            END;
        END;

        PROCEDURE ExitWithError(aString: Str255);
        BEGIN
            ExitWithMessage(concat('•••••••• Error: ', aString, '.'));
        END;

        PROCEDURE FailWithError(aString: Str255);
        BEGIN
            CleanUpBeforeFailure;
            ExitWithError(aString);
        END;

        PROCEDURE AddFileNameToResult(TheString: Str255);
        VAR
            OldSize: Size;
            NewSize: Size;
            LineFeedString: Str31;
        BEGIN

            LineFeedString := ' '; LineFeedString[1] := char(13);

            OldSize := GetHandleSize(TheResult);

            IF (OldSize <> 0) THEN TheString := concat(LineFeedString, TheString); {Add a return}

            NewSize := OldSize + length(TheString);
            SetHandleSize(TheResult, NewSize);
            if (MemError <> noErr) then FailWithError('Memory Error Constructing Result.');

            BlockMove(    Ptr(ORD4(@TheString) + 1),
                        Ptr(ORD4(TheResult^) + OldSize), { OK to dereference; won’t move mem.}
                        length(TheString));

        END;

        {This routine is based on Tech Note 68}
        PROCEDURE EnumerShell(VolumeToSearch: LongInt;
                                DirIDToSearch:Longint;
                                Directories: Boolean);
        VAR
        FName:               Str255;
        myCPB:               CInfoPBRec;
        err:                 OSErr;
        TotalFiles:           integer;
        TotalDirectories:    integer;

            PROCEDURE EnumerateCatalog(dirIDToSearch: longint);
            VAR
            index:   integer;

            Begin {EnumerateCatalog}
                index:= 1;
                repeat
                     FName:= '';
                     myCPB.ioFDirIndex:= index;
                     myCPB.ioDrDirID:= dirIDToSearch; {we need to do this
                                                       every time through}

                     err:= PBGetCatInfo(@myCPB,FALSE);

                     If err = noErr then
                         if BitTst(@myCPB.ioFlAttrib,3) then Begin {we have a dir}
                             IF (Directories) then
                                BEGIN
                                    TotalDirectories:=TotalDirectories+1;
                                    AddFileNameToResult(myCPB.ioNamePtr^);
                                    { EnumerateCatalog(myCPB.ioDrDirID); } {Recursive call}
                                END;
                            err:= 0;  {clear error return on way back}
                            End {if BitTst}
                         Else Begin {we have a file}
                             IF (Not Directories) THEN
                                BEGIN
                                    TotalFiles:= TotalFiles + 1;
                                    AddFileNameToResult(myCPB.ioNamePtr^);
                                END;
                            End; {else}
                     index:= index + 1;
                 until (err <> noErr);
            End;  {EnumerateCatalog}

        Begin    {EnumerShell}
            TotalFiles:= 0;
            TotalDirectories:= 0;

            MyCPB.ioNamePtr:= @FName; { The place where the names will be found }
            MyCPB.ioVRefNum:= VolumeToSearch;

            EnumerateCatalog(DirIDToSearch); {the root level}

        End;    {EnumerShell}

        PROCEDURE ParseParams;
        VAR
            ParamNum:            integer;
        BEGIN
            WITH paramPtr^ DO BEGIN
                IF (paramCount > MaxParams) THEN ExitWithError('Too many parameters.');

                IF (paramCount >= 1) THEN
                    BEGIN
                        ZeroToPas(paramPtr, params[1]^, ParamStrings[1]);
                        PathnameParam := ParamStrings[1];
                    END
                ELSE
                    BEGIN
                        PathnameParam := '';
                    END;

                IF (PathnameParam = '') THEN
                    BEGIN
                        TempHandle := EvalExpr(paramPtr, 'the last word of the long name of this stack');
                        ZeroToPas(ParamPtr, TempHandle^, TempString);
                        DisposHandle(TempHandle);
                        PathNameParam := Copy (TempString, 2, length(TempString) - 2);
                    END;

                IF (paramCount >= 2) THEN
                    BEGIN
                        ZeroToPas(paramPtr, params[2]^, ParamStrings[2]);
                        DirectoriesParam := StrToBool(paramPtr, ParamStrings[2]);
                    END
                ELSE
                    BEGIN
                        DirectoriesParam := FALSE;
                    END;

            END;

        END;        { ParseParams }

        FUNCTION PathNameToVolRefNum(PathName: Str255; VAR VolRefNum: Integer): Boolean;
        VAR
            MyPB:        HParamBlockRec;
            MyPBPtr:    HParmBlkPtr;
            Success:    Boolean;
        BEGIN

            MyPBPtr := @MyPB;

            MyPB.ioCompletion := NIL;
            MyPB.ioNamePtr := @PathName;
            MyPB.ioVRefNum := -1;          {* Who knows what to put here? *}
            MyPB.ioVolIndex := -1;        {* Who knows what to put here? *}

            Success := (PBHGetVInfo(MyPBPtr, FALSE) = NoErr);

            VolRefNum := MyPB.ioVRefNum;

            PathNameToVolRefNum := Success;
        END;

        FUNCTION PathNameToDirRefNum(PathName: Str255; VolRefNum: Integer; VAR DirRefNum: Integer): Boolean;
        VAR
            MyPB:        CInfoPBRec;
            MyPBPtr:    CInfoPBPtr;
            Success:    Boolean;
        BEGIN

            MyPBPtr := @MyPB;

            MyPB.ioCompletion := NIL;
            MyPB.ioNamePtr := @PathName;
            MyPB.ioVRefNum := VolRefNum;
            MyPB.ioFDirIndex := 0;        {* 0 means use ioNamePtr and ioVRefNum *}
            MyPB.ioDirID := -1;            {* This is supposed to be ignored *}

            Success := (PBGetCatInfo(MyPBPtr, FALSE) = NoErr);

            IF BitTst(@MyPB.ioFlAttrib,3)
            THEN DirRefNum := MyPB.ioDrDirID        {we have a dir -- use its dir ID}
            ELSE DirRefNum := MyPB.ioFlParID;        {we have a file -- use its parent's dir ID}

            PathNameToDirRefNum := Success;
        END;

    BEGIN {GetFileNames }
        WITH paramPtr^ DO
        BEGIN

            { Put values into PathnameParam and DirectoriesParam or fail trying }
            ParseParams;

            { Get the VolRefNum from the path name }
            IF (PathNameToVolRefNum(PathnameParam, ThisVolRefNum) = FALSE)
            THEN ExitWithError(concat('Couldn’t get volume from pathname: ', PathnameParam));

            { Translate the Path name and VolRefNum into a DirRefNum }
            IF (PathNameToDirRefNum(PathnameParam, ThisVolRefNum, ThisDirRefNum) = FALSE)
            THEN ExitWithError(concat('Couldn’t get directory from pathname: ', PathnameParam));

            { Initialize a handle for TheResult }
            TheResult := NewHandle(0); { Starts off empty}
            IF (TheResult = NIL) THEN ExitWithError('Memory error on NewHandle');

            { Call the file-name-getting routine which builds onto TheResult }
            EnumerShell(ThisVolRefNum, ThisDirRefNum, DirectoriesParam);

            ExitWithHandle(TheResult); { Zero-terminates it & returns it; HyperCard disposes. }

        END

    END { GetFileNames  } ;

END. { DummyUnit }